{**************************************************************************************************}
{                                                                                                  }
{  TBufFileStream, Version 1.0.3 alpha                                                             }
{                                                                                                  }
{  The contents of this file are subject to the Y Library Public License Version 1.0 (the          }
{  "License"); you may not use this file except in compliance with the License. You may obtain a   }
{  copy of the License at http://delphi.pjh2.de/                                                   }
{                                                                                                  }
{  Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF  }
{  ANY KIND, either express or implied. See the License for the specific language governing        }
{  rights and limitations under the License.                                                       }
{                                                                                                  }
{  The Original Code is: BufFStrm.pas.                                                             }
{  The Initial Developer of the Original Code is Peter J. Haas (libs@pjh2.de). Portions created    }
{  by Peter J. Haas are Copyright (C) 2000-2005 Peter J. Haas. All Rights Reserved.                }
{                                                                                                  }
{  Contributor(s):                                                                                 }
{                                                                                                  }
{  You may retrieve the latest version of this file at the homepage of Peter J. Haas, located at   }
{  http://delphi.pjh2.de/                                                                          }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Limitations:                                                                                     }
{     - max. file size = 2^31-1 bytes  (2 GB)                                                      }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Credits:                                                                                         }
{   Heiko Tietze for testing                                                                       }
{                                                                                                  }
{**************************************************************************************************}

// For history see end of file

unit BufferedStream;

{ notice:
   - for correct write access use 'read and write mode'
   - you can use 'only write mode' for a faster access
     under following conditions:
      - only sequential write access
      - only new file or if complete overwrite the old file }

{$ALIGN ON, $BOOLEVAL OFF, $LONGSTRINGS ON, $IOCHECKS ON, $WRITEABLECONST OFF}
{$OVERFLOWCHECKS OFF, $RANGECHECKS OFF, $TYPEDADDRESS ON, $MINENUMSIZE 1}

interface
uses
  Windows, SysUtils, Classes;

type
  TBufferedFileStream = class(TStream)
  private
    FFileHandle     : THandle;  { handle of file }
    FBufferSize     : DWord;    { buffer capacity }
    FBuffer         : PByte;    { pointer to buffer }
    FIsModified     : Boolean;  { is buffer modified }
    FBufPosition    : LongInt;  { abs. file position from first byte in buffer }
    FBufPtr         : PByte;    { pointer of current byte in buffer }
    FBufEnd         : PByte;    { pointer behind last valid byte in buffer }
                                { is FBufPtr + FBufferSize, except last block }
    procedure ReadBufferFromFile;
  protected
    procedure SetSize(NewSize: LongInt); override;
    property FileHandle: THandle read FFileHandle;  { handle of file }
  public
    { create a buffered filestream with default buffersize }
    constructor Create(const Filename: WideString; Mode: Word); overload;
    { create a buffered filestream with specific security rights and buffer  }
    constructor Create(const Filename: WideString; Mode: Word; Rights: Cardinal; BufferSize: DWord); overload;
    destructor Destroy; override;
    class function CalculateBufferSize(const Filename: WideString): DWord;
    function Read(var Buffer; Count: LongInt): LongInt; override;
    function Write(const Buffer; Count: LongInt): LongInt; override;
    function Seek(Offset: LongInt; Origin: Word): LongInt; override;
    procedure Flush;
  end;

const
  INVALID_SET_FILE_POINTER = DWORD(-1);

{ error messages }

const
  SSeekError    = 'Stream-Seek-Error';
  SSetSizeError = 'Stream-SetSize-Error';

implementation
uses
  RTLConsts, UniCode;

const
  DefaultBufferSize = 4096;  { default buffer size }
  DefaultSectorSize = 2048;   { default sector size = max known sector size (CDFS) }


constructor TBufferedFileStream.Create(const Filename: WideString; Mode: Word);
begin
  // Simple fixed size buffer 128 bytes
  Create(Filename, Mode, 0, 128);
end;

constructor TBufferedFileStream.Create(const Filename: WideString; Mode: Word;
                                       Rights: Cardinal; BufferSize: DWord);
begin
  inherited Create;

  if Mode = fmCreate then
  begin
    FFileHandle := FileCreateW(FileName, Rights);
    if FFileHandle = INVALID_HANDLE_VALUE then
      raise EFCreateError.CreateResFmt(@SFCreateError, [FileName]);
  end
  else
  begin
    FFileHandle := FileOpenW(FileName, Mode);
    if FFileHandle = INVALID_HANDLE_VALUE then
      raise EFOpenError.CreateResFmt(@SFOpenError, [FileName]);
  end;

  // Allocate buffer memory & get pointer to it
  FBufferSize := BufferSize;
  GetMem(FBuffer, FBufferSize);
  FBufPtr := FBuffer;
  FBufEnd := FBufPtr;
end;

destructor TBufferedFileStream.Destroy;
begin
  Flush;                                           { flush buffer }
  if FFileHandle <> INVALID_HANDLE_VALUE then      { close file }
    FileClose(FFileHandle);
  if FBufferSize > 0 then                          { free buffer }
    FreeMem(FBuffer, FBufferSize);
end;

class function TBufferedFileStream.CalculateBufferSize(const Filename: WideString): DWord;
var
  Drive          : String;
  SectorsPerCluster    : DWord;  // Dummy
  BytesPerSector       : DWord;
  NumberOfFreeClusters : DWord;  // Dummy
  TotalNumberOfClusters: DWord;  // Dummy
begin
  { correct buffer size }
  Result := DefaultBufferSize;
  { get sector size }
  Drive := ExtractFileDrive(Filename);
  if (Length(Drive)>0) and (Drive[Length(Drive)]<>'\') then Drive := Drive+'\';
  if Not GetDiskFreeSpace(Pointer(Drive),
                          SectorsPerCluster, BytesPerSector,
                          NumberOfFreeClusters, TotalNumberOfClusters) then
    BytesPerSector := DefaultSectorSize;  { can't get sector size -> default }
  { align buffer size to sector size }
  Result := ((Result + BytesPerSector-1) div BytesPerSector) * BytesPerSector;
end;

{ read block from file to buffer }
procedure TBufferedFileStream.ReadBufferFromFile;
var
  BytesRead : DWord;
begin
  { set file pointer to start of block }
  if SetFilePointer(FFileHandle, FBufPosition, Nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER then
    RaiseLastOSError;
  { read to buffer }
  if not ReadFile(FFileHandle, FBuffer^, FBufferSize, BytesRead, Nil) then
    RaiseLastOSError;
  FBufPtr := FBuffer;
  FBufEnd := Pointer(DWord(FBufPtr)+BytesRead);
end;

function TBufferedFileStream.Read(var Buffer; Count: LongInt): LongInt;
var
  DstPtr      : PByte;
  BytesToRead : Integer;

procedure ReadNextBlock;
var
  BytesInBuffer  : DWord;
  SaveCurrentPtr : PByte;
begin
  { calculate number of bytes in buffer }
  BytesInBuffer := DWord(FBufEnd) - DWord(FBuffer);
  { save the current position in buffer }
  SaveCurrentPtr := FBufPtr;
  { if a complete block then read next block,
    else read same block again, test to new bytes }
  Assert(BytesInBuffer <= FBufferSize, 'buffer overflow');
  if BytesInBuffer >= FBufferSize then
  begin
    Inc(FBufPosition,   FBufferSize);
    Dec(SaveCurrentPtr, FBufferSize);
  end;
  ReadBufferFromFile;                 { read to buffer }
  FBufPtr := SaveCurrentPtr;          { set position in buffer }
end;

begin
  Result := 0;
  DstPtr := @Buffer;
  if DstPtr = Nil then Exit;
  while Count > 0 do
  begin
    { calculate bytes remain in buffer }
    BytesToRead := DWord(FBufEnd) - DWord(FBufPtr);
    if BytesToRead <= 0 then  { is the end of buffer }
    begin
      { read next block }
      ReadNextBlock;
      { calculate bytes remain in buffer }
      BytesToRead := DWord(FBufEnd) - DWord(FBufPtr);
    end;
    { set number of bytes to copy }
    if BytesToRead > Count then BytesToRead := Count;
    { check end of file }
    if BytesToRead <= 0 then Break;
    { copy bytes }
    Move(FBufPtr^, DstPtr^, BytesToRead);  { copy }
    Dec(Count,   BytesToRead);             { decrement number bytes remain }
    Inc(FBufPtr, BytesToRead);             { increment position in buffer }
    Inc(DstPtr,  BytesToRead);             { increment destination pointer }
    Inc(Result,  BytesToRead);             { increment number of bytes read }
  end;
end;

function TBufferedFileStream.Write(const Buffer; Count: LongInt): LongInt;
var
  SrcPtr : PByte;
  BytesToWrite : LongInt;
begin
  Result := 0;
  SrcPtr := @Buffer;
  if SrcPtr = Nil then Exit;
  while Count > 0 do
  begin
    { calculate free space in block }
    BytesToWrite := FBufferSize- (DWord(FBufPtr) - DWord(FBuffer));
    { if no more free space then write block }
    if BytesToWrite <= 0 then
    begin
      Flush;                           { write block }
      Inc(FBufPosition, FBufferSize);  { set next block }
      ReadBufferFromFile;              { read next block }
      { calculate free space in block }
      BytesToWrite := FBufferSize - (DWord(FBufPtr) - DWord(FBuffer));
    end;
    { set number of bytes to copy }
    if BytesToWrite>Count then BytesToWrite:=Count;
    { if necessary set buffer end to new position }
    if BytesToWrite>LongInt(FBufEnd)-LongInt(FBufPtr) then
      LongInt(FBufEnd):=LongInt(FBufPtr)+BytesToWrite;
    { copy bytes }
    if BytesToWrite>0 then
    begin
      FIsModified := True;                    { mark as modified }
      Move(SrcPtr^, FBufPtr^, BytesToWrite);  { copy }
      Dec(Count,   BytesToWrite);             { decrement number bytes remain }
      Inc(SrcPtr,  BytesToWrite);             { increment source pointer }
      Inc(FBufPtr, BytesToWrite);             { increment position in buffer }
      Inc(Result,  BytesToWrite);             { increment number of bytes write }
    end;
  end;
end;

procedure TBufferedFileStream.Flush;
var
  BytesToWrite : DWord;
  BytesWrite   : DWord;
begin
  if FIsModified then
  begin
    FIsModified := False;     { mark as unmodified }
    if SetFilePointer(FFileHandle, FBufPosition, Nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER then
      RaiseLastOSError;
    BytesToWrite := DWord(FBufEnd) - DWord(FBuffer);
    if not WriteFile(FFileHandle, FBuffer^, BytesToWrite, BytesWrite, Nil) then
      RaiseLastOSError;
    if BytesToWrite <> BytesWrite then            { can't write all bytes }
      raise EWriteError.Create(SWriteError);
  end;
end;

function TBufferedFileStream.Seek(Offset: LongInt; Origin: Word): LongInt;
begin
  { calculate new absolute position }
  case Origin of
    FILE_CURRENT : begin
      Result := DWord(FBufPosition) + (DWord(FBufPtr) - DWord(FBuffer)) + DWord(Offset);
    end;
    FILE_END : begin
      Result := SetFilePointer(FFileHandle, Offset, Nil, FILE_END);  { get file size }
      if DWord(Result) = INVALID_SET_FILE_POINTER then
        RaiseLastOSError;
    end;
  else { FILE_BEGIN }
    Result := Offset;
  end;
  { is new position outside of the curent block? }
  if (Result < FBufPosition) or
     (DWord(Result) >= DWord(FBufPosition) + FBufferSize) then
  begin
    Flush;                 { write buffer }
    { calculate file position from first byte in buffer }
    FBufPosition := DWord(Result) - (DWord(Result) mod FBufferSize);
    ReadBufferFromFile;    { read block }
  end;
  { calculate position in buffer }
  FBufPtr := Pointer(DWord(FBuffer) + DWord(Result) - DWord(FBufPosition));
  { if necessary set buffer end to new position }
  if DWord(FBufEnd) < DWord(FBufPtr) then FBufEnd := FBufPtr;
end;

procedure TBufferedFileStream.SetSize(NewSize: LongInt);
begin
  if NewSize < 0 then NewSize := 0;
  { if current block in new file then write block }
  if DWord(NewSize) > DWord(FBufPosition) then Flush;
  { set file size }
  if SetFilePointer(FFileHandle, NewSize, Nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER then
    RaiseLastOSError;
  if not SetEndOfFile(FFileHandle) then
    RaiseLastOSError;
  { if current position outside of the file then set position to end of file }
  if DWord(Position) > DWord(NewSize) then Position := NewSize;
end;

// *******************************************************************************************

//  History:
//   2007-10-14, @home media
//    - added support for widestring filenames
//    - separated buffer size calculation to separate class method
//    - removed conditional compilation for old delphi versions
//    - fixed compiler warnings under delphi 2007
//
//   2005-02-20, Peter J. Haas
//    - new license
//
//   2001-02-11 Version 1.0.3 alpha
//    - BugFix Dummy variables for GetDiskFreeSpace
//      (WinNT 4.0SP6a have problems with Nil)
//
//   2000-09-16 Version 1.0.2 alpha
//    - Design FileHandle -> protected
//    - Bugfix CreateCustom: negative ABufferSize in Delphi 2, 3
//
//   2000-09-10 Version 1.0.1 alpha
//    - Bugfix Read / Write: Buffer = Nil
//    - Bugfix Read: no Return by end of file
//
//   2000-09-06 Version 1.0 alpha
//    - First test version

end.
